perm filename V.OLD[TMP,LCS] blob sn#502614 filedate 1980-02-25 generic text, type T, neo UTF8
TITLE VM     ;CREATES .VRN FILES FOR VARIAN PROGRAM.
;******** FOR THICKER LINES, FIRST TYPE <4> FOR DOTS*4 OR <9> FOR DOTS*9
	;↓↓AC DEF
A←1
B←2
C←3
D←4
E←5
L←6
U←7
X←11
Y←12
XD←13
T←15
TT←16
P←17
	
LPDL←←69
NBUFS←←4
DSK←←1
VRN←←2		;DEVICE NAME OF VARIAN STATOS

LMAR←←=0
RMAR←←=4399	;WILL DO 10.2" LONG MAXIMUM
WIDTH←←=4400	;22" WIDE PAPER    -- MAYBE 21 WOULD BE BETTER?
LBUFL←←=123	;LINE LENGTH IN WORDS

LSTBIT←←1⊗34

OVERLAP←←=50

DOFF←←-=2000

EXTERN JOBREL,JOBFF,JOBTPC,JOBAPR,JOBCNI
MAILBF:	BLOCK 40
SIGN:	0
LINE:	0
PNTR:	0

BEG:	SETOM LINE
	GETLIN LINE		;FOR ERROR PRINTOUT
	CALLI
	HRRZS LINE		;CLEAR LINE BITS
	HRRZI A,CORUP
	HRRZM A,JOBAPR
	SETOM SSS#
	HRRZ A,JOBFF		;RESET CORE WITHOUT A RESET
	CORE A,
	JRST 4,.

	MOVEI	A,20000		;REG MPV
	APRENB	A,		;REG  ENABLE OLD WAY!

	MOVE P,[-LPDL,,PDL-1]
;Z	OUTSTR [ASCIZ /OLD? /]
	SETZM BIGBOT#
	SETZM GO#
	SETZM SPREAD#
			;NEXT LINE REPLACES FOLLOWING ;Z SECTION.
;	JRST FILIN	;******* NO 'OLD' FEATURE IN THIS VERSION. ******

;GONEW:	PUSHJ P,FRD		;GO GET DEFAULT FILE NAME.
;GOGO:	MOVEI =10		;DEFAULT PAGE LENGTH = 10" WITH 'G'
;GOGOGO:	MOVEM GO
;	PUSHJ P,INCHLF
;OUTSTR [ASCIZ/USING DEFAULT VALUES.
;/]
;	SETZM ROFLG#
;	HRREI B,-60	;??
;	JRST PASS2
FILIN:	OUTSTR [ASCIZ /INPUT? (DEFAULT=PLT.PLT) /]
	PUSHJ P,FRD
;;	SKIPE GO
;;	JRST GONEW	;IF 'G' IS NAME THEN USE DEFAULT VALUES.
	SETZ A,
YAGN1:	HRREI B,-60
PASS2:	HRREI A,-=2000
YDEF:	ADD A,B
	MOVNM A,INIX#
AGAIN:	MOVE A,[FILNAM,,LKENT]
	BLT A,LKENT+3
	OPEN DSK,[14↔'DSK   '↔IBUF]
	JRST 4,.
	INBUF DSK,NBUFS
	LOOKUP DSK,LKENT
	JRST FNF
ASKLEN:	SETZM POOBX#
	SETZM POOBY#
	PUSHJ P,XINI		;GET X INFO
	SETZM XX#
	SETZM YY#
	MOVEI C,3
	HRRZM C,PENN#
OUTER:	IN DSK,
	JRST PLOT
	STATO DSK,20000
	JRST 4,.
	RELEAS DSK,
IFN LSTBIT-1,<PUSHJ P,XFIX>
	JRST XXOUT

INCHLF:	INCHWL 0		 ;GET ANOTHER CHARACTER
	CAIE 0,12		;WAS IT A LF?
	JRST INCHLF		 ;GET THE LF
	POPJ P,
XINI:	SKIPN GO
	JRST PASSD

	OUTSTR [ASCIZ /LENGTH IN INCHES (Y DIMENSION, DEFAULT=10)? /]
	SETZM DEFA#
	SKIPE GO
	JRST PASSD
	PUSHJ P,RNUM
	SETOM DEFA		;ASSUME 10  INCHES
	JUMPLE A,[XINLER:INCHWL 0      ; GET LF?
		JRST XINI]
	SKIPGE DEFA		;? GO?
PASSD:	HRRZI A,=10
	SKIPE GO
	MOVE A,GO
;;PASSD:	MOVE A,GO		;EITHER 11 OR 14
	CAIE C,12
	JRST XINLER
	IMULI A,=200
	CAILE A,=2000		;IF MORE THAN 10" IS TYPED, WE GET 10"
	MOVEI A,=2000		;THIS IS MAXIMUM FOR THIS PROGRAM(255K)
	PUSH P,A
PASS3:	MOVEI A,=0
IYDEF:	MOVEM A,SHIFT#	;A MINUS NUMBER SHIFTS IMAGE DOWN OFF PAGE
;;	PUSHJ P,NAMGET		;GET OUTPUT NAME
;;	MOVE A,SHIFT
	POP P,A
XDEF:	MOVEM A,LINCNT#
	MOVEI B,-1(A)
	IMULI A,LBUFL+1		;A← BUFSIZ ← ROWS * COL
	MOVE T,JOBFF		;GET START ADDR
	MOVEM T,XGPPTR
	SOS XGPPTR
	MOVEI T,2(A)
	MOVNI TT,(T)
	ADD T,XGPPTR
	HRLM TT,XGPPTR		;XGPPTR← -WDCNT,,ADDR-1
	MOVE TT,T

	HRRZ L,XGPPTR
	MOVSI T,1(L)
	HRRI T,2(L)
 	SETZM 1(L)
 	MOVE U,JOBREL
 	BLT T,(U)		;ZERO TO END OF CORE
	HRRZI U,(TT)
	MOVEM B,SVBBB#
	
;;	MOVE Y,IYPOS
;;	ADDI Y,2(L)
	MOVEI Y,2(L)
	MOVEI XD,DBUF+1
	SKIPL A,INIX		;WHERE DO WE START
	JRST MAYBON
	SUBI A,43
	IDIV A,[-44]
	HRLOI X,XD
	SOJA A,SETB

MAYBON:	ADDI A,43
	IDIVI A,44
	CAILE A,LBUFL
	JRST OFFRT
	MOVE X,A
	SETZ A,
	HRLI X,Y
	JRST SETB

OFFRT:	MOVE X,[XD,,LBUFL]
	SUBI A,LBUFL
SETB:	MOVE B,INIX
	IDIVI B,44
	MOVSI B,400000
	MOVN C,C
	ROT B,(C)
	POPJ P,

POPJ1:	AOS (P)
CPOPJ:	POPJ P,

PLOT:	HRR C,IBUF+1
	MOVN E,1(C)	;FIX FOR NO WDCNT
	MOVSI E,(E)
	HRR E,IBUF+1
PLOT1:	MOVE 14,2(E)
	LSHC 14,-10
	ASH 15,-34
	JUMPG 15,NORSET		;NEXT FOR RESET OF COORDS TO 0,0  (SVPEN=-1)
	JRST ENOUT
NORSET:	MOVEM 15,SVPEN#		;GET PEN CODE - NO RESET
	MOVM A,15
	LSHC 14,-16
	ASH 15,-26
SSSS:	MOVEM 15,SVY#		;GET Y
	SUB 15,YY
	MOVEM 15,SVYSB#		;SAVE Y DIFF
	IMULI 15,LBUFL+1
	ADD 15,Y
  	CAMGE 15,[=262144]	;2↑18  
  	SKIPG 15		;IF(AC15.LT.0.OR.AC15.GT.2↑18-1)SKIP THIS POINT
  	JRST ENOUT		;GO ON TO NEXT POINT, THIS WON'T FIT IN 1/2 WD.
YOK:	MOVEM 15,SVYOD#		;SAVE NEW Y
	CAIGE 15,(L)		;OFF BOTTOM
	JRST LOSE
	CAIL 15,-LBUFL-1(U)	;OFF TOP
	JRST LOSE
	LSHC 14,-16
	ASH 15,-26
	MOVEM 15,SVX#		;GET X
	SUB 15,XX
	MOVE 0,15		;0 HAS X DIFF
	HRRZ 16,X
	IMULI 16,44	;TIMES BITS INA WORD
	JFFO B,.+1	
	ADD 16,C	;PLUS REMAINDER EQ OLD X
	SUB 16,15
	JUMPL 16,LOSEX
	CAILE 16,=4427
	JRST LOSEX
	SKIPE OOBFLG#		;CK IF ALREADY OOB
	JRST OOBAR
FIXUP:	CAIE A,1	;FIXUP WHAT?
	HRRM A,PENN
	HRR A,PENN	;SAME PEN IF 1
	CAIN A,3
	JRST PENUP	;PENUP IF 3
	MOVE C,SVYSB	;Y DIFF
	IORM B,@X	;MARK NOW X Y
			;FIND DIRECTION
	JUMPE NORMX	;VERT OR NO MOVE
	JUMPL MVLFT	;LEFT
	JUMPE C,NRT	;HORZ
	JUMPL C,MVDWN	;DOWN
	CAMLE C,0	;JUMP IF Y DIFF > X DIFF
	JRST XCHA

	SETZ 14,	;↓↓ MOVE UP AND RIGHT
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
INLOOP:	ADD 15,C
	TLZE 15,200000
	ADDI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG INLOOP
	JRST DONXT

XCHA:	SETZ 14,	;↓↓MOVE UP AND RIGHT
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
INLOO:	ADD 15,0
	TLZN 15,200000
	JRST MVUP
	SKIPGE B
	SOJ X,
	ROT B,1
MVUP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,INLOO
	JRST DONXT

MVDWN:	MOVMS C		;↓↓MOVE DOWN AND RIGHT
	CAMLE C,0
	JRST XCHA2	;JUMP IF YDIFF > XDIFF
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
INLOP:	ADD 15,C
	TLZE 15,200000
	SUBI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG INLOP
	JRST DONXT

XCHA2:	SETZ 14,	;↓↓MOVE DOWN AND RIGHT
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
INOOP:	ADD 15,0
	TLZN 15,200000
	JRST MVEX
	SKIPGE B
	SOJ X,
	ROT B,1
MVEX:	SUBI Y,LBUFL+1
	IORM B,@X
	SOJG C,INOOP
	JRST DONXT

NRT:	JUMPL B,GOOP	;HORZ RIGHT
TOOT:	ROT B,1
	IORM B,@X
	SOJG 0,NRT
	JRST DONXT
GOOP:	SOJ X,
	CAIGE 0,44
	JRST TOOT
	IDIVI 0,44
	SETOM @X
	SOJ X,
	SOJG 0,.-2
	HRR 0,1
	JUMPN 0,TOOT
	AOJ X,
	JRST DONXT

NLFT:	MOVMS 0		;HORZ LEFT
	ROT B,-1
	JUMPL B,ROOT
WOOP:	IORM B,@X
	SOJG 0,.-3
	JRST DONXT
ROOT:	AOJ X,
	CAIGE 0,44
	JRST WOOP
	IDIVI 0,44
	SETOM @X
	AOJ X,
	SOJG 0,.-2
	HRR 0,1
	JUMPN 0,WOOP
	SOJ X,
	ROT B,1
	JRST DONXT
;;NORMX:	JUMPE C,NOMOVE	;NO DIFF
NORMX:	JUMPE C,ENOUT	;NO DIFF
	JUMPL C,MDOWN	;MOVE VERT DOWN
MUP:	ADDI Y,LBUFL+1	;MOVE VERT UP
	IORM B,@X
	SOJG C,MUP
	JRST DONXT
MDOWN:	SUBI Y,LBUFL+1	;MOVE VERT DOWN
	IORM B,@X
	AOJL C,MDOWN
DONXT:	MOVE 4,SVX	;DONE. NOW UPDATE X AND Y
	MOVEM 4,XX
NXTY:	MOVE 4,SVY
	MOVEM 4,YY
;;NOMOVE:	SKIPL SVPEN  ;****** THIS DONE AT 'PLOT' NOW
;;	JRST ENOUT
;;	SETZM XX	;IF NEW LOCO
;;	SETZM YY
ENOUT:	AOBJN E,PLOT1	;GET NEXT
	JRST OUTER

MVLFT:	MOVMS 0		;MOVE LEFT THEN RIGHT
	MOVMS 15
	JUMPE C,NLFT
	HRR Y,SVYOD
	IDIVI 15,44
	ADD X,15
XEND:	SOJL 16,DUN
	ROT B,-1
	JUMPGE B,XEND
	AOJ X,
	JRST XEND
DUN:	MOVEM X,XX	;SAVE NEW X POS
	MOVEM B,YY
	IORM B,@X
	JUMPL C,MVLD
	CAMLE C,0
	JRST XCHA3
	SETZ 14,	;MOVE LEFT UP
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
ILOOP:	ADD 15,C
	TLZE 15,200000
	SUBI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG ILOOP
	JRST BFOR

XCHA3:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
ILOP:	ADD 15,0
	TLZN 15,200000
	JRST DOQ
	SKIPGE B
	SOJ X,
	ROT B,1
DOQ:	SUBI Y,LBUFL+1
	IORM B,@X
	SOJG C,ILOP
	JRST BFOR

MVLD:	MOVMS C		;MOVE LEFT DOWN
	CAMLE C,0
	JRST XCHA4
	SETZ 14,
	TLNE C,200000
	JRST .+4
	LSH C,1
	TRO C,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV C,0
	MOVNS 14
	LSH C,(14)
	SETZ 15,
LOOP:	ADD 15,C
	TLZE 15,200000
	ADDI Y,LBUFL+1
	SKIPGE B
	SOJ X,
	ROT B,1
	IORM B,@X
	SOJG LOOP
	JRST BFOR

XCHA4:	SETZ 14,
	TLNE 0,200000
	JRST .+4
	LSH 0,1
	TRO 0,1
	AOJA 14,.-4
	SUBI 14,=34
	IDIV 0,C
	MOVNS 14
	LSH 0,(14)
	SETZ 15,
LOP:	ADD 15,0
	TLZN 15,200000
	JRST DOP
	SKIPGE B
	SOJ X,
	ROT B,1
DOP:	ADDI Y,LBUFL+1
	IORM B,@X
	SOJG C,LOP

BFOR:	HRR Y,SVYOD	;RESTORE PEN TO NEW PEN
	MOVE X,XX
	MOVE B,YY
	JRST DONXT

OOBAR:	SETZM OOBFLG	; GET HERE IF ALL READY OOB
	AOSG SSS	; THIS IS FOR THE FIRST OOB FROM MP
	JRST FIXUP	;
PENUP:	HRR Y,SVYOD	; PEN IS UP GET NEW Y
	JUMPE 15,NXTY	;IF VERT
	JUMPL 15,PULFT	;IF LEFT
	CAIGE 15,44	;↓↓MOVE UP PEN RIGHT TO NEW X
	JRST XLOOP
	IDIVI 15,44
	SUB X,15
	HRR 15,16
XLOOP:	SOJL 15,DONXT
	SKIPGE B
	SOJ X,
	ROT B,1
	JRST XLOOP

PULFT:	MOVMS 15	;↓↓MOVE UP PEN LEFT TO NEW X
	CAIGE 15,44
	JRST OOO
	IDIVI 15,44
	ADD X,15
	HRR 15,16
OOO:	SOJL 15,DONXT
	ROT B,-1
	JUMPGE B,OOO
	AOJ X,
	JRST OOO

LOSEX:	SETOM OOBFLG	;OOB X
	SKIPE POOBX
	JRST PENUP
	SETOM POOBX
	PUSHJ P,DETCHK
 	 PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ / POINT OUT OF BOUNDS, /
	JUMPL 16,[PUSHJ P,ERRPNT
		  ASCIZ/-X/
		  JRST PENUP]
	PUSHJ P,ERRPNT
	ASCIZ/+X/
	JRST PENUP

LOSE:	SETOM OOBFLG	;OOB Y
	SKIPE POOBY
	JRST LOBAC
	SETOM POOBY
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ / POINT OUT OF BOUNDS, /
	CAIGE 15,(L)
	JRST [	PUSHJ P,ERRPNT
		ASCIZ/-Y/
		JRST LOBAC]
	PUSHJ P,ERRPNT
	ASCIZ/+Y/
LOBAC:	LSHC 14,-16
	ASH 15,-26
	MOVEM 15,SVX
	SUB 15,XX
	JRST PENUP

DECOUT:	IDIVI T,=10	;DEC TTY OUT
	HRLM TT,(P)
	SKIPE T
	PUSHJ P,DECOUT
	HLRZ TT,(P)
	ADDI TT,60
	ROT TT,-7
	MOVEM TT,.+2
	PUSHJ P,ERRPNT
	0
	POPJ P,

ERRPNT:	HRRZ TT,(P)		;ERROR TTY OUT
	MOVEM TT,PNTR
	MOVEI TT,LINE
	TTYMES TT,
	JRST [	OUTSTR[ASCIZ/TTYMES FAILED	/]
		OUTSTR @PNTR
		OUTSTR[ASCIZ/
/]
		JRST .+1]
	POP P,TT
	HRL TT,(TT)
	TLNE TT,376
	AOJA TT,.-2
	JRST 1(TT)

XERR:	PUSHJ P,ERRPNT		;DET TTY OUT
	ASCIZ/
MESSAGE FROM X WORKING ON /
	MOVE TT,FILNAM
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/./
	HLLZ TT,FILEXT
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/[/
	MOVE TT,FILPPN
	PUSHJ P,SIXOUT
	PUSHJ P,ERRPNT
	ASCIZ/] : /
	POPJ P,

SIXOUT:	JUMPE TT,CPOPJ		;SIXBIT OUT
	SETZ T,
	LSHC T,6
	ADDI T,40
	PUSH P,TT
	ROT T,-7
	MOVEM T,.+2
	PUSHJ P,ERRPNT
	0
	POP P,TT
	JRST SIXOUT

DETCHK:	SETOM DET#	;CK FOR DET JOB
	GETLIN DET
	HRRES DET
	SKIPL DET
	AOS (P)
	POPJ P,

XXOUT:	MOVSI TT,400100
	MOVEM TT,(T)		;SO DOES LAST

	SKIPN SPREAD
	JRST XGPOUT

	HRRZ T,XGPPTR
	ADDI T,LBUFL+1
	HRRZ C,SVBBB

	SKIPG SPREAD
	JRST NINE

XLINE4:	HRLI T,-LBUFL

XSHFT4:	MOVE A,2(T)
	MOVE B,3(T)
	ROTC A,1
	ORM A,2(T)
	AOBJN T,XSHFT4
	AOJ T,
	SOJG C,XLINE4

	HRRZ T,XGPPTR
	HRRZ B,SVBBB
	
YLINE4:	HRLI T,-LBUFL

YSHFT4:	MOVE A,LBUFL+3(T)
	ORM A,2(T)
	AOBJN T,YSHFT4
	AOJ T,		;Bump past control word.
	SOJG B,YLINE4

	JRST XGPOUT

NINE:	HRLI T,-LBUFL

XSHFT9:	MOVE A,2(T)
	MOVE B,3(T)
	ROTC A,1
	ORM A,2(T)
	ROTC A,1
	ORM A,2(T)
	AOBJN T,XSHFT9
	AOJ T,
	SOJG C,NINE

	HRRZ T,XGPPTR
	HRRZ B,SVBBB

YLINE9:	HRLI T,-LBUFL

YSHFT9:	MOVE A,LBUFL+LBUFL+4(T)
	OR A,LBUFL+3(T)
	ORM A,2(T)
	AOBJN T,YSHFT9
	AOJ T,
	SOJG B,YLINE9

XGPOUT:	JRST NOXGP
	OUTSTR[ASCIZ/CRANKING VRN
/]
	LOCK
OUTIT:	OUT VRN,XGPPTR
	JRST OUTOK
DSKERR:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /VRN OUTPUT ERROR.
/
OUTOK:	UNLOCK
	RELEAS VRN,
XMORE:	PUSHJ P,DETCHK
;;	JRST DODEL			;DELETE AUTOMATICALLY IF DETACHED
	JFCL
	OUTSTR[ASCIZ/D=DELETE, R=REPEAT, X=EXIT  /]
	INCHRW C
	CAIE C,15
	JRST .+3
	INCHRW C
	JRST XMORE+2			; WON'T ACCEPT JUST CRLF
	OUTSTR[ASCIZ/
/]
	CAIE C,"X"
	CAIN C,"x"
	SKIPA
	JRST .+3
	PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
	JRST NODEL 
	CAIE C,"R"
	CAIN C,"r"
	JRST XGPOUT
	CAIE C,"D"
	CAIN C,"d"
	SKIPA   			;IF NOT R, X OR D TRY AGAIN.
	JRST XMORE+2
	PUSHJ P,CORDWN			;REALLY DONE, CORE DOWN
DODEL:	MOVE A,[FILNAM,,LKENT]
	BLT A,LKENT+3
	INIT DSK,17
	'DSK   '
	0
	JRST [	SKIPGE DET
		PUSHJ P,XERR
		PUSHJ P,ERRPNT
		ASCIZ/COULDN'T GET DISK FOR DELETE!
/
		JRST NODEL]
	LOOKUP DSK,LKENT
	JRST [	SKIPGE DET
		PUSHJ P,XERR
		PUSHJ P,ERRPNT
		ASCIZ/LOOKUP FOR DELETE FAILED!
/
		JRST NODEL]
	MOVE A,FILPPN
	MOVEM A,LKENT+3
	SETZM LKENT
	RENAME DSK,LKENT
	CAIA
	JRST NODEL
	SKIPGE DET
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ/RENAME FOR DELETE FAILED!
/
NODEL:	RELEASE DSK,
	SKIPGE DET
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ/ALL DONE!
/
	PUSHJ P,CORDWN
	CALLI 12		;LEAVE

NOXGP:	PUSHJ P,DETCHK
	PUSHJ P,XERR
	JRST OUTFIL

XNIT:	417
	'VRN   '
	0
XGPPTR:	BLOCK 2

IFN LSTBIT-1,<
XFIX:	MOVE A,[LSTBIT-1]
	HRRZ C,JOBREL
	HRRZ D,XGPPTR
XFIXL:	ANDCAM A,LBUFL-1+2(D)
	ADDI D,LBUFL+1
	CAIGE D,(C)
	JRST XFIXL
	POPJ P,
>
CORDWN:	MOVE T,JOBFF
	SUBI T,1
	CALLI T,11
	JRST 4,.
	POPJ P,

;;OUTFIL:	PUSHJ P,NAMGET		;OUTPUT BIT FILE
OUTFIL:	OUTSTR [ASCIZ/ WRITING .VRN FILE  --  /]
	MOVSI A,'VRN'
	MOVEM A,FILEXT
	MOVE U,XGPPTR
	HLRO T,U
	MOVNS T
	IDIVI T,LBUFL+1	;DIVIDE WDCNT BY WDS IN LINE (123+1)
	CAILE T,=1600	;LESS THAN 1600 SCAN LINES
	MOVEI T,=1600	;NO, LIMIT IT TO 1600
	MOVEM T,HEADER+4	;PUT AWAY FOR VARIAN PROGRAM.
	IMULI T,LBUFL+1	;RESET THE WDCNT
OUTF2:	TRZ T,177
	HRRZI A,200(T)
	ADDI A,(U)
	CORE A,
	JRST OUTFIL
	MOVNS T
	HLL T,U			;FIRST WD IS WC-200,-WC
	MOVEM T,1(U)
	HRLI U,-200(T)
	SETZ 10,
	OPEN [17↔'DSK   '↔0]
	JRST 4,.
	ENTER FILNAM
	CAIA
	MOVEI 0,HEADER
	SUBI 0,1
	MOVEM 0,COM
	MOVNI 0,200   
	HRLM 0,COM
	OUTPUT COM
	STATZ 0,740000
	HALT	;ERROR <WRITE ERROR>
	OUTPUT U
	RELEAS
	JRST NODEL
COM:	0
	0
HEADER:	0 
      	0
	=124		;MUST BE 1 MORE THAN LBUFL ON PAGE 2.
	0
 	=1200		;NUMBER OF SCAN LINES IN FILE.
	0
	117		;WORD 2 +DECIMAL 37
	0
	0
	0
;CORUP

CORUP:

REPEAT 0,<	OLD WAY - FLUSHED BY REG 1-3-76

	HRRZ B,JOBCNI
	CAIE B,20000
	DISMIS
	MOVE A,JOBTPC
	MOVEM A,IPC+1
	UWAIT
	DEBREAK
>;END REPEAT 0

BUST:	MOVEM	1,SVONE#
 	MOVEM	2,SVTWO#
	MOVEM	TT,SVTTT#
	MOVE	1,JOBCNI	;REG  GET APR CONI BITS
	TRNN	1,20000		;REG  IS THERE AN MPV?
	JRST	NOMPV		;REG  NO
	HRRZ	1,JOBREL	;OLD CORE SIZE
	MOVSI	2,1(1)		;FIRST NEW WORD WE'LL GET
	HRRI	2,2(1)		;SECOND NEW WORD  - 2 HAS A BLT POINTER.
	ADDI	1,16000
;;	ADDI	1,10000		;GET ANOTHER 8K
	MOVE	TT,1
	CORE	1,
	PUSHJ	P,CORLUZ
	HRRZ	1,JOBREL
	SETZM	-1(2)
 	BLT	2,(1)		;ZERO NEW CORE
	MOVE	1,SVONE
 	MOVE	2,SVTWO
	MOVE	TT,SVTTT

REPEAT 0,<
	INTJEN IPC
>

	JRST	2,@JOBTPC	;REG  THIS IS HOW TO DISMISS OLD INTERRUPT

NOMPV:	OUTSTR	[ASCIZ/UNEXPECTED INTERRUPT?
/]
	JRST	2,@JOBTPC

CORLUZ:	MOVE T,TT
	LSH T,-12
	PUSH P,T
	PUSHJ P,DETCHK
	PUSHJ P,XERR
	POP P,T
	PUSHJ P,DECOUT
	PUSHJ P,ERRPNT
	ASCIZ / K OF CORE NEEDED!
/
	SKIPGE DET
	CALLI 12
	JRST ASKLEN

FNF:	PUSHJ P,DETCHK		;FILE NOT FOUND
	PUSHJ P,XERR
	PUSHJ P,ERRPNT
	ASCIZ /LOOKUP FAILED.
/
	SKIPGE DET
	CALLI 12
	JRST FILIN

;******** TYPE '4' FOR 4X4 DOTS, TYPE '9' FOR 9X9 DOTS.***********

FRD:	MOVSI A,'PLT'		;FILE SCAN
	MOVEM A,FILEXT
	SKIPN GO
	JRST .+3		;GO?
	MOVEI C,12		; CR
	JRST .+3
	PUSHJ P,GETNAM
	CAME A,[SIXBIT/G/]	;G ALONE = 'GO'
	JRST GOX
	SETOM GO		;GO BACK AND USE DEFAULT NAME.
	POPJ P,

GOX:	CAME A,[SIXBIT/4/]	;FOR * FOUR
	JRST CKSEMI
	AOS SPREAD
POPBAC:	POP P,A
	PUSHJ P,INCHLF
	JRST FILIN
CKSEMI:	CAME A,[SIXBIT/9/]		;FOR * NINE
	JRST CKDEFA
	SETOM SPREAD
	JRST POPBAC
CKDEFA:	SKIPN A
 	MOVE A,['PLT   ']
    	MOVEM A,FILNAM
	CAIE C,"."
	JRST NOEXT
	PUSHJ P,GETNAM
	MOVEM A,FILEXT
NOEXT:	CAIE C,"["
	JRST FRDX
	PUSHJ P,GETP
	HRLZM A,FILPPN
	PUSHJ P,GETP
	HRRM A,FILPPN
FRDX:	SKIPN GO
	INCHRW C
	CAIE C,12
	JRST FRDX
	POPJ P,

RNUM:	INCHWL C		;NUM SCAN
	CAIN C,15
	JRST RNUM
	CAIN C,12
	POPJ P,
	AOS (P)
	MOVEI A,
	SETZM SIGN
	CAIN C,"-"
	JRST [	PUSHJ P,RNUML
		SETOM SIGN
		MOVN A,A
		POPJ P,]
	CAIN C,"+"
RNUML:	INCHWL C
	CAIL C,"0"
	CAILE C,"9"
	JRST RNUMX
	IMULI A,12
	ADDI A,-"0"(C)
	JRST RNUML

RNUMX:	CAIN C,15
	INCHRW C
	POPJ P,

GETNAM:	MOVEI A,		;FILE SCAN
	MOVE B,[440600,,A]
GETNML:	PUSHJ P,RCH
	POPJ P,
	SUBI C,40
	TLNE B,770000
	IDPB C,B
	JRST GETNML

GETP:	MOVEI A,
GETPL:	PUSHJ P,RCH
	POPJ P,
	TRNE A,770000
	JRST GETPL
	LSH A,6
	ADDI A,-40(C)
	JRST GETPL

RCH:	INCHWL C
	CAIN C,42
	JRST RCHQ
	CAIE C,11
	CAIN C," "
	JRST RCH
	CAIE C,"."
	CAIN C,","
	POPJ P,
	CAIE C,"["
	CAIN C,"]"
	POPJ P,
RCHQR:	CAIGE C,40
	POPJ P,
	CAIL C,"a"
	CAILE C,"z"
	CAIA
	SUBI C,40
	JRST POPJ1

RCHQ:	INCHWL C
	JRST RCHQR

;CNAMGET:	CLRBFI
;CCNAMGET:	INCHWL 0
;CC	INCHWL 0	;GET CRLF
;CC	INCHWL 0
;CC	INCHWL 0	;GET CRLF
NAMGET:	OUTSTR [ASCIZ/ OUTPUT FILE = /]
	SETZM FILEXT+1
	SETZM FILPPN
	MOVSI A,'VRN'
	MOVEM A,FILEXT
	PUSHJ P,GETNAM
	SKIPN A
 	MOVE A,['PLT   ']
    	MOVEM A,FILNAM
	CAIE C,"."
	JRST NOEXTN
	PUSHJ P,GETNAM
	MOVEM A,FILEXT
NOEXTN:	CAIE C,"["
	JRST FFDX
	PUSHJ P,GETP
	HRLZM A,FILPPN
	PUSHJ P,GETP
	HRRM A,FILPPN
FFDX:	INCHRW C
	CAIE C,12
	JRST FFDX
	POPJ P,

FILNAM:	0			;GLOPS OF JUNK
FILEXT:	0
	0
FILPPN:	0

LKENT:	BLOCK 4

XGSNAM:	0
XGSEXT:	0
	0
XGSPPN:	0

IBUF:	BLOCK 3

BITTAB:	FOR I←43,0,-1{1⊗I
}
BYTTAB:	FOR I←36,0,-6{REPEAT 6,{77⊗I}}

DBUF:	BLOCK LBUFL+2

PDL:	BLOCK LPDL

END BEG